home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / fb386 / biorism / baio.bas next >
BASIC Source File  |  1991-10-18  |  8KB  |  214 lines
  1. 10 '********************************************************************
  2. 20 '*                                                                  *
  3. 30 '*                        バイオリズム　　                          *
  4. 40 '*                                                                  *
  5. 50 '*                                         制作  谷口 利一 (kazu)   *
  6. 60 '*                                                                  *
  7. 70 '*                                         I D   MHF01402           *
  8. 80 '*                                                                  *
  9. 90 '********************************************************************
  10. 100 SCREEN@ 2
  11. 110 DIM DA(13)
  12. 120 DA(1)=31:DA(2)=28:DA(3)=31:DA(4)=30:DA(5)=31:DA(6)=30:DA(7)=31
  13. 130 DA(8)=31:DA(9)=30:DA(10)=31:DA(11)=30:DA(12)=31
  14. 140 COLOR 0,[255,255,255],[200,200,200],0
  15. 150 CLS
  16. 160 SYMBOL(230,100),"マウスで選んでください",1,1,2
  17. 170 SYMBOL(130,210),"西暦で入力",1,1,3
  18. 180 SYMBOL(400,210),"平成､昭和で入力",1,1,3
  19. 190 MOUSE 0
  20. 200 MOUSE 1,300,300,1
  21. 210 WHILE MOUSE(2,0)=0
  22. 220 WEND
  23. 230 X=MOUSE(0):Y=MOUSE(1)
  24. 240 A_J=0
  25. 250 IF X>305 AND Y<250 THEN A_J=2
  26. 260 IF X<305 AND Y<250 THEN A_J=3
  27. 270 MOUSE 5
  28. 280 CLS
  29. 290 LINE (0,0)-(638,80),PSET,[100,100,100],BF'上の枠の色
  30. 300 LINE (0,0)-(638,80),PSET,[255,255,255],B'上の枠
  31. 310 SYMBOL(180,23),"バ イ オ リ ズ ム",2,2,[25,200,40],0,,4
  32. 320 LINE (0,81)-(639,479),PSET,[155,155,155],BF
  33. 330 LINE (18,150)-(616,212),PSET,[255,255,255],BF'真ん中の枠の色
  34. 340 LINE (18,150)-(616,212),PSET,[0,0,0],B'真ん中の枠
  35. 350 LINE (21,213)-(620,217),PSET,[0,0,0],BF'真ん中の枠の色 黒
  36. 360 LINE (617,154)-(621,217),PSET,[0,0,0],BF'真ん中の枠の色 黒
  37. 370 IF A_J=2 THEN 540
  38. 380 IF A_J=3 THEN 390 ELSE 190
  39. 390 '
  40. 400 F_F=0:DA_1=0:DA_2=0
  41. 410 LOCATE 15,9,0 :INPUT"表示する年は19",H_Y
  42. 420 HHY=H_Y:UU=1
  43. 430 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  44. 440 LOCATE 15,9,0 :INPUT"表示する月は ",H_M
  45. 450 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  46. 460 LOCATE 15,9,0 :INPUT"生まれた年は19",T_Y
  47. 470 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  48. 480 LOCATE 15,9,0 :INPUT"生まれた月は ",T_M
  49. 490 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  50. 500 LOCATE 15,9,0 :INPUT"生まれた日は ",T_D
  51. 510 WAIT 25
  52. 520 LINE (17,149)-(625,220),PSET,[155,155,155],BF
  53. 530 GOTO 690
  54. 540 F_F=0:DA_1=0:DA_2=0
  55. 550 '
  56. 560 LOCATE 15,9,0 :INPUT"表示する年は平成          ",H_Y
  57. 570 HHY=H_Y:UU=2
  58. 580 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  59. 590 LOCATE 15,9,0 :INPUT"表示する月は              ",H_M
  60. 600 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  61. 610 LOCATE 15,9,0 :INPUT"生まれた年は昭和          ",T_Y
  62. 620 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  63. 630 LOCATE 15,9,0 :INPUT"生まれた月は              ",T_M
  64. 640 LINE (19,151)-(615,211),PSET,[255,255,255],BF'真ん中の枠の色
  65. 650 LOCATE 15,9,0 :INPUT"生まれた日は              ",T_D
  66. 660 WAIT 25
  67. 670 LINE (17,149)-(625,220),PSET,[155,155,155],BF
  68. 680 H_Y=H_Y+88:T_Y=T_Y+25
  69. 690 H_Y=H_Y+1900
  70. 700 T_Y=T_Y+1900
  71. 710 A_A=T_Y-1900              '1900年～誕生年までの年数
  72. 720 B_B=A_A MOD 4             '年数を4で割った余り
  73. 730 C_C=H_Y-T_Y               '表示年～誕生年までの年数
  74. 740 D_D=B_B+C_C               '年数と余りの年数の合計
  75. 750 E_E=INT(D_D/4)            '閏年の計算
  76. 760 G_G=H_Y MOD 4
  77. 770 IF B_B=0 THEN E_E=E_E+1
  78. 780 F_F=(H_Y+1-T_Y)*365+E_E   '年数の計算
  79. 790 FOR I=1 TO T_M STEP 1
  80. 800 DA_1=DA_1+DA(I-1)
  81. 810 NEXT I
  82. 820 FOR I=H_M TO 12 STEP 1
  83. 830 DA_2=DA_2+DA(I)
  84. 840 NEXT I
  85. 850 IF B_B=0 AND T_M>=3  THEN DA_1=DA_1+1
  86. 860 IF G_G=0 AND H_M<=2 THEN DA_2=DA_2+1
  87. 870 DAY=F_F-(DA_1+DA_2)-(T_D-1)
  88. 880 '-------------------------------------------------------------------
  89. 890 II=17*DA(H_M)
  90. 900 IF G_G=0 AND H_M=2  THEN II=II+1
  91. 910 FOR I=1 TO II STEP 17
  92. 920 LINE (638-I,102)-(638-I,294),PSET,3
  93. 930 NEXT I
  94. 940  FOR I=0 TO 194 STEP 96
  95. 950  IF DA(H_M)=31 THEN N=0
  96. 960  IF DA(H_M)=30 THEN N=17
  97. 970  IF G_G=0 AND H_M=2  THEN N=34
  98. 980  IF G_G><0 AND H_M=2  THEN N=51
  99. 990  LINE (128+N,102+I)-(638,102+I),PSET,3
  100. 1000  NEXT I
  101. 1010 '--------------------------------------------------------------------
  102. 1020 C_Y=(31-DA(H_M))*17 
  103. 1030 IF UU=1 THEN LOCATE 1,6,0 :PRINT"19":LOCATE 3,6,0 :PRINT HHY:LOCATE 6,6,0 :PRINT"年":LOCATE 8,6,0 :PRINT H_M: LOCATE 11,6,0 :PRINT"月"
  104. 1040 IF UU=2 THEN LOCATE 1,6,0 :PRINT"平成":LOCATE 5,6,0 :PRINT HHY:LOCATE 7,6,0 :PRINT"年":LOCATE 9,6,0 :PRINT H_M: LOCATE 12,6,0 :PRINT"月"
  105. 1050 SYMBOL(90,195),"感情",1,1,5
  106. 1060 SYMBOL(90,235),"身体",1,1,4
  107. 1070 SYMBOL(90,275),"知性",1,1,6
  108. 1080 IF G_G=0 AND H_M=2  THEN C_Y=C_Y-17
  109. 1090 SYMBOL(123+C_Y,87),"1",1,1,4
  110. 1100 SYMBOL(123+68+C_Y,87),"5",1,1,4
  111. 1110 SYMBOL(123+149+C_Y,87),"10",1,1,4
  112. 1120 SYMBOL(123+234+C_Y,87),"15",1,1,4
  113. 1130 SYMBOL(123+319+C_Y,87),"20",1,1,4
  114. 1140 SYMBOL(123+406+C_Y,87),"25",1,1,4
  115. 1150 IF DA(H_M)=31 THEN SYMBOL(123+489+C_Y,87),"30",1,1,4
  116. 1160 '--------------------------------------------------------------------
  117. 1170 YY=DAY MOD 23
  118. 1180 DD=(DA(H_M)-28)*17
  119. 1190 IF G_G=0 AND H_M=2  THEN DD=DD+17
  120. 1200 AA=YY*.274!
  121. 1210 BB=YY*17
  122. 1220 BB=BB+DD
  123. 1230 OX=176-BB
  124. 1240 A=AA-.1!:B=20:DX=.1!
  125. 1250 FOR X=1 TO 100 STEP 1
  126. 1260 A=A+.1!
  127. 1270 Y=SIN(A)*3
  128. 1280 XG=OX+63*A:YG=190-31*Y
  129. 1290 SYMBOL(XG,YG),"･",1,1,4
  130. 1300 NEXT X
  131. 1310 '--------------------------------------------------------------------
  132. 1320 YY=DAY MOD 28
  133. 1330 DD=(DA(H_M)-28)*17
  134. 1340 IF G_G=0 AND H_M=2  THEN DD=DD+17
  135. 1350 AA=YY*.225!
  136. 1360 BB=YY*17
  137. 1370 BB=BB+DD
  138. 1380 OX=176-BB
  139. 1390 A=AA-.1!:B=20:DX=.1!
  140. 1400 FOR X=1 TO 100 STEP 1
  141. 1410 A=A+.1!
  142. 1420 Y=SIN(A)*3
  143. 1430 XG=OX+77*A:YG=190-31*Y
  144. 1440 SYMBOL(XG,YG),"･",1,1,5
  145. 1450 NEXT X
  146. 1460 '--------------------------------------------------------------------
  147. 1470 YY=DAY MOD 33
  148. 1480 DD=(DA(H_M)-28)*17
  149. 1490 IF G_G=0 AND H_M=2  THEN DD=DD+17
  150. 1500 AA=YY*.189!
  151. 1510 BB=YY*17
  152. 1520 BB=BB+DD
  153. 1530 OX=176-BB
  154. 1540 A=AA-.1!:B=20:DX=.1!
  155. 1550 FOR X=1 TO 100 STEP 1
  156. 1560 A=A+.1!
  157. 1570 Y=SIN(A)*3
  158. 1580 XG=OX+90*A:YG=190-31*Y
  159. 1590 SYMBOL(XG,YG),"･",1,1,6
  160. 1600 NEXT X
  161. 1610 U=0
  162. 1620 FOR I=1 TO 3
  163. 1630 U=U+1
  164. 1640 LINE (205-U,375+I)-(445,375+I),PSET,[0,0,0]' 黒 横
  165. 1650 LINE (445+I,325-U)-(445+I,378),PSET,[0,0,0]' 黒 縦
  166. 1660 LINE (202,325-I)-(445+U,325-I),PSET,[255,255,255]' 白 横<-- ^
  167. 1670 LINE (205-I,325)-(205-I,375+U),PSET,[255,255,255]' 白 縦
  168. 1680 '--------------------------------------------------------------------
  169. 1690 LINE (160-U,450+I)-(300,450+I),PSET,[0,0,0]' 黒 横
  170. 1700 LINE (300+I,400-U)-(300+I,453),PSET,[0,0,0]' 黒 縦
  171. 1710 LINE (157,400-I)-(300+U,400-I),PSET,[255,255,255]' 白 横<-- ^
  172. 1720 LINE (160-I,400)-(160-I,450+U),PSET,[255,255,255]' 白 縦
  173. 1730 '--------------------------------------------------------------------
  174. 1740 LINE (350-U,450+I)-(490,450+I),PSET,[0,0,0]' 黒 横--> ^
  175. 1750 LINE (490+I,400-U)-(490+I,453),PSET,[0,0,0]' 黒 縦
  176. 1760 LINE (347,400-I)-(490+U,400-I),PSET,[255,255,255]' 白 横
  177. 1770 LINE (350-I,400)-(350-I,450+U),PSET,[255,255,255]' 白 縦
  178. 1780 NEXT I
  179. 1790 SYMBOL(230,335)," もういちど",2,2,[205,155,15]
  180. 1800 SYMBOL(150,410),"  す  る      しない",2,2,[105,100,25]
  181. 1810 MOUSE 0
  182. 1820 MOUSE 1,325,425,1
  183. 1830 MOUSE 4,157,400,490,450
  184. 1840 WHILE MOUSE(2,0)=0
  185. 1850 WEND
  186. 1860 X=MOUSE(0):Y=MOUSE(1)
  187. 1870 A_K=0
  188. 1880 IF X>325 THEN A_K=2
  189. 1890 MOUSE 5
  190. 1900 IF A_K=2 THEN 2010 ELSE 1910
  191. 1910 '--------------------------------------------------------------------
  192. 1920 U=0
  193. 1930 FOR I=1 TO 3
  194. 1940 U=U+1
  195. 1950 LINE (160-U,450+I)-(300,450+I),PSET,[255,255,255]' 白 横<-- ^
  196. 1960 LINE (300+I,400-U)-(300+I,453),PSET,[255,255,255]' 白 縦
  197. 1970 LINE (157,400-I)-(300+U,400-I),PSET,[0,0,0]' 黒 横
  198. 1980 LINE (160-I,400)-(160-I,450+U),PSET,[0,0,0]' 黒 縦
  199. 1990 NEXT I
  200. 1991 WAIT 50
  201. 2000 GOTO 140
  202. 2010 '--------------------------------------------------------------------
  203. 2020 U=0
  204. 2030 FOR I=1 TO 3
  205. 2040 U=U+1
  206. 2050 LINE (350-U,450+I)-(490,450+I),PSET,[255,255,255]' 白 横
  207. 2060 LINE (490+I,400-U)-(490+I,453),PSET,[255,255,255]' 白 縦
  208. 2070 LINE (347,400-I)-(490+U,400-I),PSET,[0,0,0]' 黒 横--> ^
  209. 2080 LINE (350-I,400)-(350-I,450+U),PSET,[0,0,0]' 黒 縦
  210. 2090 NEXT I
  211. 2091 WAIT 50
  212. 2100 '--------------------------------------------------------------------
  213. 2110 CLS:END
  214.